home *** CD-ROM | disk | FTP | other *** search
/ Kompuutteri K-CD 2002 #1 / K-CD_2002-01.iso / Delphi / INSTALL / program files / Borland / Delphi6 / Doc / System.int < prev    next >
Encoding:
Text File  |  2001-05-22  |  63.2 KB  |  1,644 lines

  1. { *********************************************************************** }
  2. {                                                                         }
  3. { Delphi / Kylix Cross-Platform Runtime Library                           }
  4. { System Unit                                                             }
  5. {                                                                         }
  6. { Copyright (c) 1988-2001 Borland Software Corporation                    }
  7. {                                                                         }
  8. { *********************************************************************** }
  9.  
  10. unit System; { Predefined constants, types, procedures, }
  11.              { and functions (such as True, Integer, or }
  12.              { Writeln) do not have actual declarations.}
  13.              { Instead they are built into the compiler }
  14.              { and are treated as if they were declared }
  15.              { at the beginning of the System unit.     }
  16.  
  17. {$H+,I-,R-,O+,W-}
  18. {$WARN SYMBOL_PLATFORM OFF}
  19.  
  20. { L- should never be specified.
  21.  
  22.   The IDE needs to find DebugHook (through the C++
  23.   compiler sometimes) for integrated debugging to
  24.   function properly.
  25.  
  26.   ILINK will generate debug info for DebugHook if
  27.   the object module has not been compiled with debug info.
  28.  
  29.   ILINK will not generate debug info for DebugHook if
  30.   the object module has been compiled with debug info.
  31.  
  32.   Thus, the Pascal compiler must be responsible for
  33.   generating the debug information for that symbol
  34.   when a debug-enabled object file is produced.
  35. }
  36.  
  37. interface
  38.  
  39. (* You can use RTLVersion in $IF expressions to test the runtime library
  40.   version level independently of the compiler version level.
  41.   Example:  {$IF RTLVersion >= 16.2} ... {$IFEND}                  *)
  42.  
  43. const
  44.   RTLVersion = 14.1;
  45.  
  46. {$EXTERNALSYM CompilerVersion}
  47.  
  48. (*
  49. const
  50.   CompilerVersion = 0.0;
  51.  
  52.   CompilerVersion is assigned a value by the compiler when
  53.   the system unit is compiled.  It indicates the revision level of the
  54.   compiler features / language syntax, which may advance independently of
  55.   the RTLVersion.  CompilerVersion can be tested in $IF expressions and
  56.   should be used instead of testing for the VERxxx conditional define.
  57.   Always test for greater than or less than a known revision level.
  58.   It's a bad idea to test for a specific revision level.
  59. *)
  60.  
  61.  
  62. {$IFDEF DECLARE_GPL}
  63. (* The existence of the GPL symbol indicates that the System unit
  64.   and the rest of the Delphi runtime library were compiled for use
  65.   and distribution under the terms of the GNU General Public License (GPL).
  66.   Under the terms of the GPL, all applications compiled with the
  67.   GPL version of the Delphi runtime library must also be distributed
  68.   under the terms of the GPL.
  69.   For more information about the GNU GPL, see
  70.   http://www.gnu.org/copyleft/gpl.html
  71.  
  72.   The GPL symbol does not exist in the Delphi runtime library
  73.   purchased for commercial/proprietary software development.
  74.  
  75.   If your source code needs to know which licensing model it is being
  76.   compiled into, you can use {$IF DECLARED(GPL)}...{$IFEND} to
  77.   test for the existence of the GPL symbol.  The value of the
  78.   symbol itself is not significant.   *)
  79.  
  80. const
  81.   GPL = True;
  82. {$ENDIF}
  83.  
  84. { Variant type codes (wtypes.h) }
  85.  
  86.   varEmpty    = $0000; { vt_empty       }
  87.   varNull     = $0001; { vt_null        }
  88.   varSmallint = $0002; { vt_i2          }
  89.   varInteger  = $0003; { vt_i4          }
  90.   varSingle   = $0004; { vt_r4          }
  91.   varDouble   = $0005; { vt_r8          }
  92.   varCurrency = $0006; { vt_cy          }
  93.   varDate     = $0007; { vt_date        }
  94.   varOleStr   = $0008; { vt_bstr        }
  95.   varDispatch = $0009; { vt_dispatch    }
  96.   varError    = $000A; { vt_error       }
  97.   varBoolean  = $000B; { vt_bool        }
  98.   varVariant  = $000C; { vt_variant     }
  99.   varUnknown  = $000D; { vt_unknown     }
  100. //varDecimal  = $000E; { vt_decimal     } {UNSUPPORTED}
  101.                        { undefined  $0f } {UNSUPPORTED}
  102.   varShortInt = $0010; { vt_i1          }
  103.   varByte     = $0011; { vt_ui1         }
  104.   varWord     = $0012; { vt_ui2         }
  105.   varLongWord = $0013; { vt_ui4         }
  106.   varInt64    = $0014; { vt_i8          }
  107. //varWord64   = $0015; { vt_ui8         } {UNSUPPORTED}
  108.  
  109.   { if adding new items, update Variants' varLast, BaseTypeMap and OpTypeMap }
  110.   varStrArg   = $0048; { vt_clsid    }
  111.   varString   = $0100; { Pascal string; not OLE compatible }
  112.   varAny      = $0101; { Corba any }
  113.   varTypeMask = $0FFF;
  114.   varArray    = $2000;
  115.   varByRef    = $4000;
  116.  
  117. { TVarRec.VType values }
  118.  
  119.   vtInteger    = 0;
  120.   vtBoolean    = 1;
  121.   vtChar       = 2;
  122.   vtExtended   = 3;
  123.   vtString     = 4;
  124.   vtPointer    = 5;
  125.   vtPChar      = 6;
  126.   vtObject     = 7;
  127.   vtClass      = 8;
  128.   vtWideChar   = 9;
  129.   vtPWideChar  = 10;
  130.   vtAnsiString = 11;
  131.   vtCurrency   = 12;
  132.   vtVariant    = 13;
  133.   vtInterface  = 14;
  134.   vtWideString = 15;
  135.   vtInt64      = 16;
  136.  
  137. { Virtual method table entries }
  138.  
  139.   vmtSelfPtr           = -76;
  140.   vmtIntfTable         = -72;
  141.   vmtAutoTable         = -68;
  142.   vmtInitTable         = -64;
  143.   vmtTypeInfo          = -60;
  144.   vmtFieldTable        = -56;
  145.   vmtMethodTable       = -52;
  146.   vmtDynamicTable      = -48;
  147.   vmtClassName         = -44;
  148.   vmtInstanceSize      = -40;
  149.   vmtParent            = -36;
  150.   vmtSafeCallException = -32;
  151.   vmtAfterConstruction = -28;
  152.   vmtBeforeDestruction = -24;
  153.   vmtDispatch          = -20;
  154.   vmtDefaultHandler    = -16;
  155.   vmtNewInstance       = -12;
  156.   vmtFreeInstance      = -8;
  157.   vmtDestroy           = -4;
  158.  
  159.   vmtQueryInterface    = 0;
  160.   vmtAddRef            = 4;
  161.   vmtRelease           = 8;
  162.   vmtCreateObject      = 12;
  163.  
  164. type
  165.  
  166.   TObject = class;
  167.  
  168.   TClass = class of TObject;
  169.  
  170.   HRESULT = type Longint;  { from WTYPES.H }
  171.   {$EXTERNALSYM HRESULT}
  172.  
  173.   PGUID = ^TGUID;
  174.   TGUID = packed record
  175.     D1: LongWord;
  176.     D2: Word;
  177.     D3: Word;
  178.     D4: array[0..7] of Byte;
  179.   end;
  180.  
  181.   PInterfaceEntry = ^TInterfaceEntry;
  182.   TInterfaceEntry = packed record
  183.     IID: TGUID;
  184.     VTable: Pointer;
  185.     IOffset: Integer;
  186.     ImplGetter: Integer;
  187.   end;
  188.  
  189.   PInterfaceTable = ^TInterfaceTable;
  190.   TInterfaceTable = packed record
  191.     EntryCount: Integer;
  192.     Entries: array[0..9999] of TInterfaceEntry;
  193.   end;
  194.  
  195.   TMethod = record
  196.     Code, Data: Pointer;
  197.   end;
  198.  
  199. { TObject.Dispatch accepts any data type as its Message parameter.  The
  200.   first 2 bytes of the data are taken as the message id to search for
  201.   in the object's message methods.  TDispatchMessage is an example of
  202.   such a structure with a word field for the message id.
  203. }
  204.   TDispatchMessage = record
  205.     MsgID: Word;
  206.   end;
  207.  
  208.   TObject = class
  209.     constructor Create;
  210.     procedure Free;
  211.     class function InitInstance(Instance: Pointer): TObject;
  212.     procedure CleanupInstance;
  213.     function ClassType: TClass;
  214.     class function ClassName: ShortString;
  215.     class function ClassNameIs(const Name: string): Boolean;
  216.     class function ClassParent: TClass;
  217.     class function ClassInfo: Pointer;
  218.     class function InstanceSize: Longint;
  219.     class function InheritsFrom(AClass: TClass): Boolean;
  220.     class function MethodAddress(const Name: ShortString): Pointer;
  221.     class function MethodName(Address: Pointer): ShortString;
  222.     function FieldAddress(const Name: ShortString): Pointer;
  223.     function GetInterface(const IID: TGUID; out Obj): Boolean;
  224.     class function GetInterfaceEntry(const IID: TGUID): PInterfaceEntry;
  225.     class function GetInterfaceTable: PInterfaceTable;
  226.     function SafeCallException(ExceptObject: TObject;
  227.       ExceptAddr: Pointer): HResult; virtual;
  228.     procedure AfterConstruction; virtual;
  229.     procedure BeforeDestruction; virtual;
  230.     procedure Dispatch(var Message); virtual;
  231.     procedure DefaultHandler(var Message); virtual;
  232.     class function NewInstance: TObject; virtual;
  233.     procedure FreeInstance; virtual;
  234.     destructor Destroy; virtual;
  235.   end;
  236.  
  237. const
  238.   S_OK = 0;                             {$EXTERNALSYM S_OK}
  239.   S_FALSE = $00000001;                  {$EXTERNALSYM S_FALSE}
  240.   E_NOINTERFACE = HRESULT($80004002);   {$EXTERNALSYM E_NOINTERFACE}
  241.   E_UNEXPECTED = HRESULT($8000FFFF);    {$EXTERNALSYM E_UNEXPECTED}
  242.   E_NOTIMPL = HRESULT($80004001);       {$EXTERNALSYM E_NOTIMPL}
  243.  
  244. type
  245.   IInterface = interface
  246.     ['{00000000-0000-0000-C000-000000000046}']
  247.     function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  248.     function _AddRef: Integer; stdcall;
  249.     function _Release: Integer; stdcall;
  250.   end;
  251.  
  252.   (*$HPPEMIT '#define IInterface IUnknown' *)
  253.  
  254.   IUnknown = IInterface;
  255. {$M+}
  256.   IInvokable = interface(IInterface)
  257.   end;
  258. {$M-}
  259.  
  260.   IDispatch = interface(IUnknown)
  261.     ['{00020400-0000-0000-C000-000000000046}']
  262.     function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
  263.     function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
  264.     function GetIDsOfNames(const IID: TGUID; Names: Pointer;
  265.       NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
  266.     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  267.       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  268.   end;
  269.  
  270. {$EXTERNALSYM IUnknown}
  271. {$EXTERNALSYM IDispatch}
  272.  
  273. { TInterfacedObject provides a threadsafe default implementation
  274.   of IInterface.  You should use TInterfaceObject as the base class
  275.   of objects implementing interfaces.  }
  276.  
  277.   TInterfacedObject = class(TObject, IInterface)
  278.   protected
  279.     FRefCount: Integer;
  280.     function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  281.     function _AddRef: Integer; stdcall;
  282.     function _Release: Integer; stdcall;
  283.   public
  284.     procedure AfterConstruction; override;
  285.     procedure BeforeDestruction; override;
  286.     class function NewInstance: TObject; override;
  287.     property RefCount: Integer;
  288.   end;
  289.  
  290.   TInterfacedClass = class of TInterfacedObject;
  291.  
  292. { TAggregatedObject and TContainedObject are suitable base
  293.   classes for interfaced objects intended to be aggregated
  294.   or contained in an outer controlling object.  When using
  295.   the "implements" syntax on an interface property in
  296.   an outer object class declaration, use these types
  297.   to implement the inner object.
  298.  
  299.   Interfaces implemented by aggregated objects on behalf of
  300.   the controller should not be distinguishable from other
  301.   interfaces provided by the controller.  Aggregated objects
  302.   must not maintain their own reference count - they must
  303.   have the same lifetime as their controller.  To achieve this,
  304.   aggregated objects reflect the reference count methods
  305.   to the controller.
  306.  
  307.   TAggregatedObject simply reflects QueryInterface calls to
  308.   its controller.  From such an aggregated object, one can
  309.   obtain any interface that the controller supports, and
  310.   only interfaces that the controller supports.  This is
  311.   useful for implementing a controller class that uses one
  312.   or more internal objects to implement the interfaces declared
  313.   on the controller class.  Aggregation promotes implementation
  314.   sharing across the object hierarchy.
  315.  
  316.   TAggregatedObject is what most aggregate objects should
  317.   inherit from, especially when used in conjunction with
  318.   the "implements" syntax.  }
  319.  
  320.   TAggregatedObject = class(TObject)
  321.   protected
  322.     { IInterface }
  323.     function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  324.     function _AddRef: Integer; stdcall;
  325.     function _Release: Integer; stdcall;
  326.   public
  327.     constructor Create(const Controller: IInterface);
  328.     property Controller: IInterface;
  329.   end;
  330.  
  331.   { TContainedObject is an aggregated object that isolates
  332.     QueryInterface on the aggregate from the controller.
  333.     TContainedObject will return only interfaces that the
  334.     contained object itself implements, not interfaces
  335.     that the controller implements.  This is useful for
  336.     implementing nodes that are attached to a controller and
  337.     have the same lifetime as the controller, but whose
  338.     interface identity is separate from the controller.
  339.     You might do this if you don't want the consumers of
  340.     an aggregated interface to have access to other interfaces
  341.     implemented by the controller - forced encapsulation.
  342.     This is a less common case than TAggregatedObject.  }
  343.  
  344.   TContainedObject = class(TAggregatedObject, IInterface)
  345.   protected
  346.     { IInterface }
  347.     function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
  348.   end;
  349.  
  350.   PShortString = ^ShortString;
  351.   PAnsiString = ^AnsiString;
  352.   PWideString = ^WideString;
  353.   PString = PAnsiString;
  354.  
  355.   UCS2Char = WideChar;
  356.   PUCS2Char = PWideChar;
  357.   UCS4Char = type LongWord;
  358.   {$NODEFINE UCS4CHAR}
  359.   PUCS4Char = ^UCS4Char;
  360.   {$NODEFINE PUCS4CHAR}
  361.   TUCS4CharArray = array [0..$effffff] of UCS4Char;
  362.   PUCS4CharArray = ^TUCS4CharArray;
  363.   UCS4String = array of UCS4Char;
  364.   {$NODEFINE UCS4String}
  365.  
  366.   UTF8String = type string;
  367.   PUTF8String = ^UTF8String;
  368.   {$NODEFINE UTF8String}
  369.   {$NODEFINE PUTF8String}
  370.  
  371.   IntegerArray  = array[0..$effffff] of Integer;
  372.   PIntegerArray = ^IntegerArray;
  373.   PointerArray = array [0..512*1024*1024 - 2] of Pointer;
  374.   PPointerArray = ^PointerArray;
  375.   TBoundArray = array of Integer;
  376.   TPCharArray = packed array[0..(MaxLongint div SizeOf(PChar))-1] of PChar;
  377.   PPCharArray = ^TPCharArray;
  378.  
  379.   (*$HPPEMIT 'namespace System' *)
  380.   (*$HPPEMIT '{' *)
  381.   (*$HPPEMIT '  typedef int *PLongint;' *)
  382.   (*$HPPEMIT '  typedef bool *PBoolean;' *)
  383.   (*$HPPEMIT '  typedef PChar *PPChar;' *)
  384.   (*$HPPEMIT '  typedef double *PDouble;' *)
  385.   (*$HPPEMIT '  typedef wchar_t UCS4Char;' *)
  386.   (*$HPPEMIT '  typedef wchar_t *PUCS4Char;' *)
  387.   (*$HPPEMIT '  typedef DynamicArray<UCS4Char>  UCS4String;' *)
  388.   (*$HPPEMIT '}' *)
  389.   PLongint      = ^Longint;
  390.   {$EXTERNALSYM PLongint}
  391.   PInteger      = ^Integer;
  392.   PCardinal     = ^Cardinal;
  393.   PWord         = ^Word;
  394.   PSmallInt     = ^SmallInt;
  395.   PByte         = ^Byte;
  396.   PShortInt     = ^ShortInt;
  397.   PInt64        = ^Int64;
  398.   PLongWord     = ^LongWord;
  399.   PSingle       = ^Single;
  400.   PDouble       = ^Double;
  401.   PDate         = ^Double;
  402.   PDispatch     = ^IDispatch;
  403.   PPDispatch    = ^PDispatch;
  404.   PError        = ^LongWord;
  405.   PWordBool     = ^WordBool;
  406.   PUnknown      = ^IUnknown;
  407.   PPUnknown     = ^PUnknown;
  408.   {$NODEFINE PByte}
  409.   PPWideChar    = ^PWideChar;
  410.   PPChar        = ^PChar;
  411.   PPAnsiChar    = PPChar;
  412.   PExtended     = ^Extended;
  413.   PComp         = ^Comp;
  414.   PCurrency     = ^Currency;
  415.   PVariant      = ^Variant;
  416.   POleVariant   = ^OleVariant;
  417.   PPointer      = ^Pointer;
  418.   PBoolean      = ^Boolean;
  419.  
  420.   TDateTime = type Double;
  421.   PDateTime = ^TDateTime;
  422.  
  423.   THandle = LongWord;
  424.  
  425.   TVarArrayBound = packed record
  426.     ElementCount: Integer;
  427.     LowBound: Integer;
  428.   end;
  429.   TVarArrayBoundArray = array [0..0] of TVarArrayBound;
  430.   PVarArrayBoundArray = ^TVarArrayBoundArray;
  431.   TVarArrayCoorArray = array [0..0] of Integer;
  432.   PVarArrayCoorArray = ^TVarArrayCoorArray;
  433.  
  434.   PVarArray = ^TVarArray;
  435.   TVarArray = packed record
  436.     DimCount: Word;
  437.     Flags: Word;
  438.     ElementSize: Integer;
  439.     LockCount: Integer;
  440.     Data: Pointer;
  441.     Bounds: TVarArrayBoundArray;
  442.   end;
  443.  
  444.   TVarType = Word;
  445.   PVarData = ^TVarData;
  446.   {$EXTERNALSYM PVarData}
  447.   TVarData = packed record
  448.     VType: TVarType;
  449.     case Integer of
  450.       0: (Reserved1: Word;
  451.           case Integer of
  452.             0: (Reserved2, Reserved3: Word;
  453.                 case Integer of
  454.                   varSmallInt: (VSmallInt: SmallInt);
  455.                   varInteger:  (VInteger: Integer);
  456.                   varSingle:   (VSingle: Single);
  457.                   varDouble:   (VDouble: Double);
  458.                   varCurrency: (VCurrency: Currency);
  459.                   varDate:     (VDate: TDateTime);
  460.                   varOleStr:   (VOleStr: PWideChar);
  461.                   varDispatch: (VDispatch: Pointer);
  462.                   varError:    (VError: LongWord);
  463.                   varBoolean:  (VBoolean: WordBool);
  464.                   varUnknown:  (VUnknown: Pointer);
  465.                   varShortInt: (VShortInt: ShortInt);
  466.                   varByte:     (VByte: Byte);
  467.                   varWord:     (VWord: Word);
  468.                   varLongWord: (VLongWord: LongWord);
  469.                   varInt64:    (VInt64: Int64);
  470.                   varString:   (VString: Pointer);
  471.                   varAny:      (VAny: Pointer);
  472.                   varArray:    (VArray: PVarArray);
  473.                   varByRef:    (VPointer: Pointer);
  474.                );
  475.             1: (VLongs: array[0..2] of LongInt);
  476.          );
  477.       2: (VWords: array [0..6] of Word);
  478.       3: (VBytes: array [0..13] of Byte);
  479.   end;
  480.   {$EXTERNALSYM TVarData}
  481.  
  482. type
  483.   TVarOp = Integer;
  484.  
  485. const
  486.   opAdd =        0;
  487.   opSubtract =   1;
  488.   opMultiply =   2;
  489.   opDivide =     3;
  490.   opIntDivide =  4;
  491.   opModulus =    5;
  492.   opShiftLeft =  6;
  493.   opShiftRight = 7;
  494.   opAnd =        8;
  495.   opOr =         9;
  496.   opXor =        10;
  497.   opCompare =    11;
  498.   opNegate =     12;
  499.   opNot =        13;
  500.  
  501.   opCmpEQ =      14;
  502.   opCmpNE =      15;
  503.   opCmpLT =      16;
  504.   opCmpLE =      17;
  505.   opCmpGT =      18;
  506.   opCmpGE =      19;
  507.  
  508. type
  509.   { Dispatch call descriptor }
  510.   PCallDesc = ^TCallDesc;
  511.   TCallDesc = packed record
  512.     CallType: Byte;
  513.     ArgCount: Byte;
  514.     NamedArgCount: Byte;
  515.     ArgTypes: array[0..255] of Byte;
  516.   end;
  517.  
  518.   PDispDesc = ^TDispDesc;
  519.   TDispDesc = packed record
  520.     DispID: Integer;
  521.     ResType: Byte;
  522.     CallDesc: TCallDesc;
  523.   end;
  524.  
  525.   PVariantManager = ^TVariantManager;
  526.   {$EXTERNALSYM PVariantManager}
  527.   TVariantManager = record
  528.     VarClear: procedure(var V : Variant);
  529.     VarCopy: procedure(var Dest: Variant; const Source: Variant);
  530.     VarCopyNoInd: procedure; // ARGS PLEASE!
  531.     VarCast: procedure(var Dest: Variant; const Source: Variant; VarType: Integer);
  532.     VarCastOle: procedure(var Dest: Variant; const Source: Variant; VarType: Integer);
  533.  
  534.     VarToInt: function(const V: Variant): Integer;
  535.     VarToInt64: function(const V: Variant): Int64;
  536.     VarToBool: function(const V: Variant): Boolean;
  537.     VarToReal: function(const V: Variant): Extended;
  538.     VarToCurr: function(const V: Variant): Currency;
  539.     VarToPStr: procedure(var S; const V: Variant);
  540.     VarToLStr: procedure(var S: string; const V: Variant);
  541.     VarToWStr: procedure(var S: WideString; const V: Variant);
  542.     VarToIntf: procedure(var Unknown: IInterface; const V: Variant);
  543.     VarToDisp: procedure(var Dispatch: IDispatch; const V: Variant);
  544.     VarToDynArray: procedure(var DynArray: Pointer; const V: Variant; TypeInfo: Pointer);
  545.  
  546.     VarFromInt: procedure(var V: Variant; const Value, Range: Integer);
  547.     VarFromInt64: procedure(var V: Variant; const Value: Int64);
  548.     VarFromBool: procedure(var V: Variant; const Value: Boolean);
  549.     VarFromReal: procedure; // var V: Variant; const Value: Real
  550.     VarFromTDateTime: procedure; // var V: Variant; const Value: TDateTime
  551.     VarFromCurr: procedure; // var V: Variant; const Value: Currency
  552.     VarFromPStr: procedure(var V: Variant; const Value: ShortString);
  553.     VarFromLStr: procedure(var V: Variant; const Value: string);
  554.     VarFromWStr: procedure(var V: Variant; const Value: WideString);
  555.     VarFromIntf: procedure(var V: Variant; const Value: IInterface);
  556.     VarFromDisp: procedure(var V: Variant; const Value: IDispatch);
  557.     VarFromDynArray: procedure(var V: Variant; const DynArray: Pointer; TypeInfo: Pointer);
  558.     OleVarFromPStr: procedure(var V: OleVariant; const Value: ShortString);
  559.     OleVarFromLStr: procedure(var V: OleVariant; const Value: string);
  560.     OleVarFromVar: procedure(var V: OleVariant; const Value: Variant);
  561.     OleVarFromInt: procedure(var V: OleVariant; const Value, Range: Integer);
  562.  
  563.     VarOp: procedure(var Left: Variant; const Right: Variant; OpCode: TVarOp);
  564.     VarCmp: procedure(const Left, Right: TVarData; const OpCode: TVarOp); { result is set in the flags }
  565.     VarNeg: procedure(var V: Variant);
  566.     VarNot: procedure(var V: Variant);
  567.  
  568.     DispInvoke: procedure(Dest: PVarData; const Source: TVarData;
  569.       CallDesc: PCallDesc; Params: Pointer); cdecl;
  570.     VarAddRef: procedure(var V: Variant);
  571.  
  572.     VarArrayRedim: procedure(var A : Variant; HighBound: Integer);
  573.     VarArrayGet: function(var A: Variant; IndexCount: Integer;
  574.       Indices: Integer): Variant; cdecl;
  575.     VarArrayPut: procedure(var A: Variant; const Value: Variant;
  576.       IndexCount: Integer; Indices: Integer); cdecl;
  577.  
  578.     WriteVariant: function(var T: Text; const V: Variant; Width: Integer): Pointer;
  579.     Write0Variant: function(var T: Text; const V: Variant): Pointer;
  580.   end;
  581.   {$EXTERNALSYM TVariantManager}
  582.  
  583.   { Dynamic array support }
  584.   PDynArrayTypeInfo = ^TDynArrayTypeInfo;
  585.   {$EXTERNALSYM PDynArrayTypeInfo}
  586.   TDynArrayTypeInfo = packed record
  587.     kind: Byte;
  588.     name: string[0];
  589.     elSize: Longint;
  590.     elType: ^PDynArrayTypeInfo;
  591.     varType: Integer;
  592.   end;
  593.   {$EXTERNALSYM TDynArrayTypeInfo}
  594.  
  595.   PVarRec = ^TVarRec;
  596.   TVarRec = record { do not pack this record; it is compiler-generated }
  597.     case Byte of
  598.       vtInteger:    (VInteger: Integer; VType: Byte);
  599.       vtBoolean:    (VBoolean: Boolean);
  600.       vtChar:       (VChar: Char);
  601.       vtExtended:   (VExtended: PExtended);
  602.       vtString:     (VString: PShortString);
  603.       vtPointer:    (VPointer: Pointer);
  604.       vtPChar:      (VPChar: PChar);
  605.       vtObject:     (VObject: TObject);
  606.       vtClass:      (VClass: TClass);
  607.       vtWideChar:   (VWideChar: WideChar);
  608.       vtPWideChar:  (VPWideChar: PWideChar);
  609.       vtAnsiString: (VAnsiString: Pointer);
  610.       vtCurrency:   (VCurrency: PCurrency);
  611.       vtVariant:    (VVariant: PVariant);
  612.       vtInterface:  (VInterface: Pointer);
  613.       vtWideString: (VWideString: Pointer);
  614.       vtInt64:      (VInt64: PInt64);
  615.   end;
  616.  
  617.   PMemoryManager = ^TMemoryManager;
  618.   TMemoryManager = record
  619.     GetMem: function(Size: Integer): Pointer;
  620.     FreeMem: function(P: Pointer): Integer;
  621.     ReallocMem: function(P: Pointer; Size: Integer): Pointer;
  622.   end;
  623.  
  624.   THeapStatus = record
  625.     TotalAddrSpace: Cardinal;
  626.     TotalUncommitted: Cardinal;
  627.     TotalCommitted: Cardinal;
  628.     TotalAllocated: Cardinal;
  629.     TotalFree: Cardinal;
  630.     FreeSmall: Cardinal;
  631.     FreeBig: Cardinal;
  632.     Unused: Cardinal;
  633.     Overhead: Cardinal;
  634.     HeapErrorCode: Cardinal;
  635.   end;
  636.  
  637. {$IFDEF PC_MAPPED_EXCEPTIONS}
  638.   PUnwinder = ^TUnwinder;
  639.   TUnwinder = record
  640.     RaiseException: function(Exc: Pointer): LongBool; cdecl;
  641.     RegisterIPLookup: function(fn: Pointer; StartAddr, EndAddr: LongInt; Context: Pointer; GOT: LongInt): LongBool; cdecl;
  642.     UnregisterIPLookup: procedure(StartAddr: LongInt) cdecl;
  643.     DelphiLookup: function(Addr: LongInt; Context: Pointer): Pointer; cdecl;
  644.     ClosestHandler: function(Context: Pointer): LongWord; cdecl;
  645.   end;
  646. {$ENDIF PC_MAPPED_EXCEPTIONS}
  647.  
  648.   PackageUnitEntry = packed record
  649.     Init, FInit : Pointer;
  650.   end;
  651.  
  652.   { Compiler generated table to be processed sequentially to init & finit all package units }
  653.   { Init: 0..Max-1; Final: Last Initialized..0                                              }
  654.   UnitEntryTable = array [0..9999999] of PackageUnitEntry;
  655.   PUnitEntryTable = ^UnitEntryTable;
  656.  
  657.   PackageInfoTable = packed record
  658.     UnitCount : Integer;      { number of entries in UnitInfo array; always > 0 }
  659.     UnitInfo : PUnitEntryTable;
  660.   end;
  661.  
  662.   PackageInfo = ^PackageInfoTable;
  663.  
  664.   { Each package exports a '@GetPackageInfoTable' which can be used to retrieve }
  665.   { the table which contains compiler generated information about the package DLL }
  666.   GetPackageInfoTable = function : PackageInfo;
  667.  
  668. {$IFDEF DEBUG_FUNCTIONS}
  669. { Inspector Query; implementation in GETMEM.INC; no need to conditionalize that }
  670.   THeapBlock = record
  671.     Start: Pointer;
  672.     Size: Cardinal;
  673.   end;
  674.  
  675.   THeapBlockArray = array of THeapBlock;
  676.   TObjectArray = array of TObject;
  677.  
  678. function GetHeapBlocks: THeapBlockArray;
  679. function FindObjects(AClass: TClass; FindDerived: Boolean): TObjectArray;
  680. { Inspector Query }
  681. {$ENDIF}
  682.  
  683. {
  684.   When an exception is thrown, the exception object that is thrown is destroyed
  685.   automatically when the except clause which handles the exception is exited.
  686.   There are some cases in which an application may wish to acquire the thrown
  687.   object and keep it alive after the except clause is exited.  For this purpose,
  688.   we have added the AcquireExceptionObject and ReleaseExceptionObject functions.
  689.   These functions maintain a reference count on the most current exception object,
  690.   allowing applications to legitimately obtain references.  If the reference count
  691.   for an exception that is being thrown is positive when the except clause is exited,
  692.   then the thrown object is not destroyed by the RTL, but assumed to be in control
  693.   of the application.  It is then the application's responsibility to destroy the
  694.   thrown object.  If the reference count is zero, then the RTL will destroy the
  695.   thrown object when the except clause is exited.
  696. }
  697. function AcquireExceptionObject: Pointer;
  698. procedure ReleaseExceptionObject;
  699.  
  700. {$IFDEF PC_MAPPED_EXCEPTIONS}
  701. procedure GetUnwinder(var Dest: TUnwinder);
  702. procedure SetUnwinder(const NewUnwinder: TUnwinder);
  703. function IsUnwinderSet: Boolean;
  704.  
  705. //function SysRegisterIPLookup(ModuleHandle, StartAddr, EndAddr: LongInt; Context: Pointer; GOT: LongInt): LongBool;
  706. {
  707.   Do NOT call these functions.  They are for internal use only:
  708.     SysRegisterIPLookup
  709.     SysUnregisterIPLookup
  710.     BlockOSExceptions
  711.     UnblockOSExceptions
  712.     AreOSExceptionsBlocked
  713. }
  714. function SysRegisterIPLookup(StartAddr, EndAddr: LongInt; Context: Pointer; GOT: LongInt): LongBool;
  715. procedure SysUnregisterIPLookup(StartAddr: LongInt);
  716. //function SysAddressIsInPCMap(Addr: LongInt): Boolean;
  717. function SysClosestDelphiHandler(Context: Pointer): LongWord;
  718. procedure BlockOSExceptions;
  719. procedure UnblockOSExceptions;
  720. function AreOSExceptionsBlocked: Boolean;
  721.  
  722. {$ELSE}
  723. // These functions are not portable.  Use AcquireExceptionObject above instead
  724. function RaiseList: Pointer; deprecated;  { Stack of current exception objects }
  725. function SetRaiseList(NewPtr: Pointer): Pointer; deprecated;  { returns previous value }
  726. {$ENDIF}
  727.  
  728. function ExceptObject: TObject;
  729. function ExceptAddr: Pointer;
  730.  
  731.  
  732. procedure SetInOutRes(NewValue: Integer);
  733.  
  734. type
  735.   TAssertErrorProc = procedure (const Message, Filename: string;
  736.     LineNumber: Integer; ErrorAddr: Pointer);
  737.   TSafeCallErrorProc = procedure (ErrorCode: HResult; ErrorAddr: Pointer);
  738.  
  739. {$IFDEF DEBUG}
  740. {
  741.   This variable is just for debugging the exception handling system.  See
  742.   _DbgExcNotify for the usage.
  743. }
  744. var
  745.   ExcNotificationProc : procedure (  NotificationKind: Integer;
  746.   ExceptionObject: Pointer;
  747.   ExceptionName: PShortString;
  748.   ExceptionLocation: Pointer;
  749.   HandlerAddr: Pointer) = nil;
  750. {$ENDIF}
  751.  
  752. var
  753.   DispCallByIDProc: Pointer;
  754.   ExceptProc: Pointer;    { Unhandled exception handler }
  755.   ErrorProc: procedure (ErrorCode: Byte; ErrorAddr: Pointer);     { Error handler procedure }
  756. {$IFDEF MSWINDOWS}
  757.   ExceptClsProc: Pointer; { Map an OS Exception to a Delphi class reference }
  758.   ExceptObjProc: Pointer; { Map an OS Exception to a Delphi class instance }
  759.   RaiseExceptionProc: Pointer;
  760.   RTLUnwindProc: Pointer;
  761. {$ENDIF}
  762.   ExceptionClass: TClass; { Exception base class (must be Exception) }
  763.   SafeCallErrorProc: TSafeCallErrorProc; { Safecall error handler }
  764.   AssertErrorProc: TAssertErrorProc; { Assertion error handler }
  765.   ExitProcessProc: procedure; { Hook to be called just before the process actually exits }
  766.   AbstractErrorProc: procedure; { Abstract method error handler }
  767.   HPrevInst: LongWord deprecated;    { Handle of previous instance - HPrevInst cannot be tested for multiple instances in Win32}
  768.   MainInstance: LongWord;   { Handle of the main(.EXE) HInstance }
  769.   MainThreadID: LongWord;   { ThreadID of thread that module was initialized in }
  770.   IsLibrary: Boolean;       { True if module is a DLL }
  771.   CmdShow: Integer platform;       { CmdShow parameter for CreateWindow }
  772.   CmdLine: PChar platform;         { Command line pointer }
  773.   InitProc: Pointer;        { Last installed initialization procedure }
  774.   ExitCode: Integer = 0;    { Program result }
  775.   ExitProc: Pointer;        { Last installed exit procedure }
  776.   ErrorAddr: Pointer = nil; { Address of run-time error }
  777.   RandSeed: Longint = 0;    { Base for random number generator }
  778.   IsConsole: Boolean;       { True if compiled as console app }
  779.   IsMultiThread: Boolean;   { True if more than one thread }
  780.   FileMode: Byte = 2;       { Standard mode for opening files }
  781. {$IFDEF LINUX}
  782.   FileAccessRights: Integer platform; { Default access rights for opening files }
  783.   ArgCount: Integer platform;
  784.   ArgValues: PPChar platform;
  785. {$ENDIF}
  786.   Test8086: Byte;         { CPU family (minus one) See consts below }
  787.   Test8087: Byte = 3;     { assume 80387 FPU or OS supplied FPU emulation }
  788.   TestFDIV: Shortint;     { -1: Flawed Pentium, 0: Not determined, 1: Ok }
  789.   Input: Text;            { Standard input }
  790.   Output: Text;           { Standard output }
  791.   ErrOutput: Text;        { Standard error output }
  792.   envp: PPChar platform;
  793.  
  794. const
  795.   CPUi386     = 2;
  796.   CPUi486     = 3;
  797.   CPUPentium  = 4;
  798.  
  799. var
  800.   Default8087CW: Word = $1332;{ Default 8087 control word.  FPU control
  801.                                 register is set to this value.
  802.                                 CAUTION:  Setting this to an invalid value
  803.                                 could cause unpredictable behavior. }
  804.  
  805.   HeapAllocFlags: Word platform = 2;   { Heap allocation flags, gmem_Moveable }
  806.   DebugHook: Byte platform = 0;        { 1 to notify debugger of non-Delphi exceptions
  807.                                 >1 to notify debugger of exception unwinding }
  808.   JITEnable: Byte platform = 0;        { 1 to call UnhandledExceptionFilter if the exception
  809.                                 is not a Pascal exception.
  810.                                 >1 to call UnhandledExceptionFilter for all exceptions }
  811.   NoErrMsg: Boolean platform = False;  { True causes the base RTL to not display the message box
  812.                                 when a run-time error occurs }
  813. {$IFDEF LINUX}
  814.                               { CoreDumpEnabled = True will cause unhandled
  815.                                 exceptions and runtime errors to raise a
  816.                                 SIGABRT signal, which will cause the OS to
  817.                                 coredump the process address space.  This can
  818.                                 be useful for postmortem debugging. }
  819.   CoreDumpEnabled: Boolean platform = False;
  820. {$ENDIF}
  821.  
  822. type
  823. (*$NODEFINE TTextLineBreakStyle*)
  824.   TTextLineBreakStyle = (tlbsLF, tlbsCRLF);
  825.  
  826. var   { Text output line break handling.  Default value for all text files }
  827.   DefaultTextLineBreakStyle: TTextLineBreakStyle = {$IFDEF LINUX} tlbsLF {$ENDIF}
  828.                                                  {$IFDEF MSWINDOWS} tlbsCRLF {$ENDIF};
  829. const
  830.   sLineBreak = {$IFDEF LINUX} #10 {$ENDIF} {$IFDEF MSWINDOWS} #13#10 {$ENDIF};
  831.  
  832. type
  833.   HRSRC = THandle;
  834.   TResourceHandle = HRSRC;   // make an opaque handle type
  835.   HINST = THandle;
  836.   HMODULE = HINST;
  837.   HGLOBAL = THandle;
  838.  
  839. {$IFDEF ELF}
  840. { ELF resources }
  841. function FindResource(ModuleHandle: HMODULE; ResourceName, ResourceType: PChar): TResourceHandle;
  842. function LoadResource(ModuleHandle: HMODULE; ResHandle: TResourceHandle): HGLOBAL;
  843. function SizeofResource(ModuleHandle: HMODULE; ResHandle: TResourceHandle): Integer;
  844. function LockResource(ResData: HGLOBAL): Pointer;
  845. function UnlockResource(ResData: HGLOBAL): LongBool;
  846. function FreeResource(ResData: HGLOBAL): LongBool;
  847. {$ENDIF}
  848.  
  849. { Memory manager support }
  850.  
  851. procedure GetMemoryManager(var MemMgr: TMemoryManager);
  852. procedure SetMemoryManager(const MemMgr: TMemoryManager);
  853. function IsMemoryManagerSet: Boolean;
  854.  
  855. function SysGetMem(Size: Integer): Pointer;
  856. function SysFreeMem(P: Pointer): Integer;
  857. function SysReallocMem(P: Pointer; Size: Integer): Pointer;
  858.  
  859. var
  860.   AllocMemCount: Integer; { Number of allocated memory blocks }
  861.   AllocMemSize: Integer;  { Total size of allocated memory blocks }
  862.  
  863. {$IFDEF MSWINDOWS}
  864. function GetHeapStatus: THeapStatus; platform;
  865. {$ENDIF}
  866.  
  867. { Thread support }
  868. type
  869.   TThreadFunc = function(Parameter: Pointer): Integer;
  870. {$IFDEF LINUX}
  871.   TSize_T = Cardinal;
  872.  
  873.   TSchedParam = record
  874.     sched_priority: Integer;
  875.   end;
  876.  
  877.   pthread_attr_t = record
  878.     __detachstate,
  879.     __schedpolicy: Integer;
  880.     __schedparam: TSchedParam;
  881.     __inheritsched,
  882.     __scope: Integer;
  883.     __guardsize: TSize_T;
  884.     __stackaddr_set: Integer;
  885.     __stackaddr: Pointer;
  886.     __stacksize: TSize_T;
  887.   end;
  888.   {$EXTERNALSYM pthread_attr_t}
  889.   TThreadAttr = pthread_attr_t;
  890.   PThreadAttr = ^TThreadAttr;
  891.  
  892.   TBeginThreadProc = function (Attribute: PThreadAttr;
  893.     ThreadFunc: TThreadFunc; Parameter: Pointer;
  894.     var ThreadId: Cardinal): Integer;
  895.   TEndThreadProc = procedure(ExitCode: Integer);
  896.  
  897. var
  898.   BeginThreadProc: TBeginThreadProc = nil;
  899.   EndThreadProc: TEndThreadProc = nil;
  900. {$ENDIF}
  901.  
  902. {$IFDEF MSWINDOWS}
  903. function BeginThread(SecurityAttributes: Pointer; StackSize: LongWord;
  904.   ThreadFunc: TThreadFunc; Parameter: Pointer; CreationFlags: LongWord;
  905.   var ThreadId: LongWord): Integer;
  906. {$ENDIF}
  907. {$IFDEF LINUX}
  908. function BeginThread(Attribute: PThreadAttr; ThreadFunc: TThreadFunc;
  909.                      Parameter: Pointer; var ThreadId: Cardinal): Integer;
  910.  
  911. {$ENDIF}
  912. procedure EndThread(ExitCode: Integer);
  913.  
  914. { Standard procedures and functions }
  915.  
  916. const
  917. { File mode magic numbers }
  918.  
  919.   fmClosed = $D7B0;
  920.   fmInput  = $D7B1;
  921.   fmOutput = $D7B2;
  922.   fmInOut  = $D7B3;
  923.  
  924. { Text file flags         }
  925.   tfCRLF   = $1;    // Dos compatibility flag, for CR+LF line breaks and EOF checks
  926.  
  927. type
  928. { Typed-file and untyped-file record }
  929.  
  930.   TFileRec = packed record (* must match the size the compiler generates: 332 bytes *)
  931.     Handle: Integer;
  932.     Mode: Word;
  933.     Flags: Word;
  934.     case Byte of
  935.       0: (RecSize: Cardinal);   //  files of record
  936.       1: (BufSize: Cardinal;    //  text files
  937.           BufPos: Cardinal;
  938.           BufEnd: Cardinal;
  939.           BufPtr: PChar;
  940.           OpenFunc: Pointer;
  941.           InOutFunc: Pointer;
  942.           FlushFunc: Pointer;
  943.           CloseFunc: Pointer;
  944.           UserData: array[1..32] of Byte;
  945.           Name: array[0..259] of Char; );
  946.   end;
  947.  
  948. { Text file record structure used for Text files }
  949.   PTextBuf = ^TTextBuf;
  950.   TTextBuf = array[0..127] of Char;
  951.   TTextRec = packed record (* must match the size the compiler generates: 460 bytes *)
  952.     Handle: Integer;       (* must overlay with TFileRec *)
  953.     Mode: Word;
  954.     Flags: Word;
  955.     BufSize: Cardinal;
  956.     BufPos: Cardinal;
  957.     BufEnd: Cardinal;
  958.     BufPtr: PChar;
  959.     OpenFunc: Pointer;
  960.     InOutFunc: Pointer;
  961.     FlushFunc: Pointer;
  962.     CloseFunc: Pointer;
  963.     UserData: array[1..32] of Byte;
  964.     Name: array[0..259] of Char;
  965.     Buffer: TTextBuf;
  966.   end;
  967.  
  968.   TTextIOFunc = function (var F: TTextRec): Integer;
  969.   TFileIOFunc = function (var F: TFileRec): Integer;
  970.  
  971. procedure SetLineBreakStyle(var T: Text; Style: TTextLineBreakStyle);
  972.  
  973. procedure ChDir(const S: string); overload;
  974. procedure ChDir(P: PChar); overload;
  975. function Flush(var t: Text): Integer;
  976. procedure _LGetDir(D: Byte; var S: string);
  977. procedure _SGetDir(D: Byte; var S: ShortString);
  978. function IOResult: Integer;
  979. procedure MkDir(const S: string); overload;
  980. procedure MkDir(P: PChar); overload;
  981. procedure Move(const Source; var Dest; Count: Integer);
  982. function ParamCount: Integer;
  983. function ParamStr(Index: Integer): string;
  984. procedure Randomize;
  985. procedure RmDir(const S: string); overload;
  986. procedure RmDir(P: PChar); overload;
  987. function UpCase(Ch: Char): Char;
  988.  
  989. { Control 8087 control word }
  990.  
  991. procedure Set8087CW(NewCW: Word);
  992. function Get8087CW: Word;
  993.  
  994. { Wide character support procedures and functions for C++ }
  995. { These functions should not be used in Delphi code!
  996.  (conversion is implicit in Delphi code)      }
  997.  
  998. function WideCharToString(Source: PWideChar): string;
  999. function WideCharLenToString(Source: PWideChar; SourceLen: Integer): string;
  1000. procedure WideCharToStrVar(Source: PWideChar; var Dest: string);
  1001. procedure WideCharLenToStrVar(Source: PWideChar; SourceLen: Integer;
  1002.   var Dest: string);
  1003. function StringToWideChar(const Source: string; Dest: PWideChar;
  1004.   DestSize: Integer): PWideChar;
  1005.  
  1006. { PUCS4Chars returns a pointer to the UCS4 char data in the
  1007.   UCS4String array, or a pointer to a null char if UCS4String is empty }
  1008.  
  1009. function PUCS4Chars(const S: UCS4String): PUCS4Char;
  1010.  
  1011. { Widestring <-> UCS4 conversion }
  1012.  
  1013. function WideStringToUCS4String(const S: WideString): UCS4String;
  1014. function UCS4StringToWideString(const S: UCS4String): WideString;
  1015.  
  1016. { PChar/PWideChar Unicode <-> UTF8 conversion }
  1017.  
  1018. // UnicodeToUTF8(3):
  1019. // UTF8ToUnicode(3):
  1020. // Scans the source data to find the null terminator, up to MaxBytes
  1021. // Dest must have MaxBytes available in Dest.
  1022. // MaxDestBytes includes the null terminator (last char in the buffer will be set to null)
  1023. // Function result includes the null terminator.
  1024.  
  1025. function UnicodeToUtf8(Dest: PChar; Source: PWideChar; MaxBytes: Integer): Integer; overload; deprecated;
  1026. function Utf8ToUnicode(Dest: PWideChar; Source: PChar; MaxChars: Integer): Integer; overload; deprecated;
  1027.  
  1028. // UnicodeToUtf8(4):
  1029. // UTF8ToUnicode(4):
  1030. // MaxDestBytes includes the null terminator (last char in the buffer will be set to null)
  1031. // Function result includes the null terminator.
  1032. // Nulls in the source data are not considered terminators - SourceChars must be accurate
  1033.  
  1034. function UnicodeToUtf8(Dest: PChar; MaxDestBytes: Cardinal; Source: PWideChar; SourceChars: Cardinal): Cardinal; overload;
  1035. function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: Cardinal; Source: PChar; SourceBytes: Cardinal): Cardinal; overload;
  1036.  
  1037. { WideString <-> UTF8 conversion }
  1038.  
  1039. function UTF8Encode(const WS: WideString): UTF8String;
  1040. function UTF8Decode(const S: UTF8String): WideString;
  1041.  
  1042. { Ansi <-> UTF8 conversion }
  1043.  
  1044. function AnsiToUtf8(const S: string): UTF8String;
  1045. function Utf8ToAnsi(const S: UTF8String): string;
  1046.  
  1047. { OLE string support procedures and functions }
  1048.  
  1049. function OleStrToString(Source: PWideChar): string;
  1050. procedure OleStrToStrVar(Source: PWideChar; var Dest: string);
  1051. function StringToOleStr(const Source: string): PWideChar;
  1052.  
  1053. { Variant manager support procedures and functions }
  1054.  
  1055. procedure GetVariantManager(var VarMgr: TVariantManager);
  1056. procedure SetVariantManager(const VarMgr: TVariantManager);
  1057. function IsVariantManagerSet: Boolean;
  1058.  
  1059. { Variant support procedures and functions }
  1060.  
  1061. procedure _VarClear(var V: Variant);
  1062. procedure _VarCopy(var Dest: Variant; const Source: Variant);
  1063. procedure _VarCopyNoInd;
  1064. procedure _VarCast(var Dest: Variant; const Source: Variant; VarType: Integer);
  1065. procedure _VarCastOle(var Dest: Variant; const Source: Variant; VarType: Integer);
  1066. procedure _VarClr(var V: Variant);
  1067.  
  1068. { Variant text streaming support }
  1069.  
  1070. function _WriteVariant(var T: Text; const V: Variant; Width: Integer): Pointer;
  1071. function _Write0Variant(var T: Text; const V: Variant): Pointer;
  1072.  
  1073. { Variant math and conversion support }
  1074.  
  1075. function _VarToInt(const V: Variant): Integer;
  1076. function _VarToInt64(const V: Variant): Int64;
  1077. function _VarToBool(const V: Variant): Boolean;
  1078. function _VarToReal(const V: Variant): Extended;
  1079. function _VarToCurr(const V: Variant): Currency;
  1080. procedure _VarToPStr(var S; const V: Variant);
  1081. procedure _VarToLStr(var S: string; const V: Variant);
  1082. procedure _VarToWStr(var S: WideString; const V: Variant);
  1083. procedure _VarToIntf(var Unknown: IInterface; const V: Variant);
  1084. procedure _VarToDisp(var Dispatch: IDispatch; const V: Variant);
  1085. procedure _VarToDynArray(var DynArray: Pointer; const V: Variant; TypeInfo: Pointer);
  1086.  
  1087. procedure _VarFromInt(var V: Variant; const Value, Range: Integer);
  1088. procedure _VarFromInt64(var V: Variant; const Value: Int64);
  1089. procedure _VarFromBool(var V: Variant; const Value: Boolean);
  1090. procedure _VarFromReal; // var V: Variant; const Value: Real
  1091. procedure _VarFromTDateTime; // var V: Variant; const Value: TDateTime
  1092. procedure _VarFromCurr; // var V: Variant; const Value: Currency
  1093. procedure _VarFromPStr(var V: Variant; const Value: ShortString);
  1094. procedure _VarFromLStr(var V: Variant; const Value: string);
  1095. procedure _VarFromWStr(var V: Variant; const Value: WideString);
  1096. procedure _VarFromIntf(var V: Variant; const Value: IInterface);
  1097. procedure _VarFromDisp(var V: Variant; const Value: IDispatch);
  1098. procedure _VarFromDynArray(var V: Variant; const DynArray: Pointer; TypeInfo: Pointer);
  1099. procedure _OleVarFromPStr(var V: OleVariant; const Value: ShortString);
  1100. procedure _OleVarFromLStr(var V: OleVariant; const Value: string);
  1101. procedure _OleVarFromVar(var V: OleVariant; const Value: Variant);
  1102. procedure _OleVarFromInt(var V: OleVariant; const Value, Range: Integer);
  1103.  
  1104. procedure _VarAdd(var Left: Variant; const Right: Variant);
  1105. procedure _VarSub(var Left: Variant; const Right: Variant);
  1106. procedure _VarMul(var Left: Variant; const Right: Variant);
  1107. procedure _VarDiv(var Left: Variant; const Right: Variant);
  1108. procedure _VarMod(var Left: Variant; const Right: Variant);
  1109. procedure _VarAnd(var Left: Variant; const Right: Variant);
  1110. procedure _VarOr(var Left: Variant; const Right: Variant);
  1111. procedure _VarXor(var Left: Variant; const Right: Variant);
  1112. procedure _VarShl(var Left: Variant; const Right: Variant);
  1113. procedure _VarShr(var Left: Variant; const Right: Variant);
  1114. procedure _VarRDiv(var Left: Variant; const Right: Variant);
  1115.  
  1116. procedure _VarCmpEQ(const Left, Right: Variant); // result is set in the flags
  1117. procedure _VarCmpNE(const Left, Right: Variant); // result is set in the flags
  1118. procedure _VarCmpLT(const Left, Right: Variant); // result is set in the flags
  1119. procedure _VarCmpLE(const Left, Right: Variant); // result is set in the flags
  1120. procedure _VarCmpGT(const Left, Right: Variant); // result is set in the flags
  1121. procedure _VarCmpGE(const Left, Right: Variant); // result is set in the flags
  1122.  
  1123. procedure _VarNeg(var V: Variant);
  1124. procedure _VarNot(var V: Variant);
  1125.  
  1126. { Variant dispatch and reference support }
  1127.  
  1128. procedure _DispInvoke; cdecl; // Dest: PVarData; const Source: TVarData;
  1129.                               // CallDesc: PCallDesc; Params: Pointer
  1130. procedure _IntfDispCall; cdecl; // ARGS PLEASE!
  1131. procedure _IntfVarCall; cdecl; // ARGS PLEASE!
  1132. procedure _VarAddRef(var V: Variant);
  1133.  
  1134. { Variant array support procedures and functions }
  1135.  
  1136. procedure _VarArrayRedim(var A : Variant; HighBound: Integer);
  1137. function _VarArrayGet(var A: Variant; IndexCount: Integer;
  1138.   Indices: Integer): Variant; cdecl;
  1139. procedure _VarArrayPut(var A: Variant; const Value: Variant;
  1140.   IndexCount: Integer; Indices: Integer); cdecl;
  1141.  
  1142. { Package/Module registration and unregistration }
  1143.  
  1144. type
  1145.   PLibModule = ^TLibModule;
  1146.   TLibModule = record
  1147.     Next: PLibModule;
  1148.     Instance: LongWord;
  1149.     CodeInstance: LongWord;
  1150.     DataInstance: LongWord;
  1151.     ResInstance: LongWord;
  1152.     Reserved: Integer;
  1153. {$IFDEF LINUX}
  1154.     InstanceVar: Pointer platform;
  1155.     GOT: LongWord platform;
  1156.     CodeSegStart: LongWord platform;
  1157.     CodeSegEnd: LongWord platform;
  1158.     InitTable: Pointer platform;
  1159. {$ENDIF}
  1160.   end;
  1161.  
  1162.   TEnumModuleFunc = function (HInstance: Integer; Data: Pointer): Boolean;
  1163.   {$EXTERNALSYM TEnumModuleFunc}
  1164.   TEnumModuleFuncLW = function (HInstance: LongWord; Data: Pointer): Boolean;
  1165.   {$EXTERNALSYM TEnumModuleFuncLW}
  1166.   TModuleUnloadProc = procedure (HInstance: Integer);
  1167.   {$EXTERNALSYM TModuleUnloadProc}
  1168.   TModuleUnloadProcLW = procedure (HInstance: LongWord);
  1169.   {$EXTERNALSYM TModuleUnloadProcLW}
  1170.  
  1171.   PModuleUnloadRec = ^TModuleUnloadRec;
  1172.   TModuleUnloadRec = record
  1173.     Next: PModuleUnloadRec;
  1174.     Proc: TModuleUnloadProcLW;
  1175.   end;
  1176.  
  1177. var
  1178.   LibModuleList: PLibModule = nil;
  1179.   ModuleUnloadList: PModuleUnloadRec = nil;
  1180.  
  1181. procedure RegisterModule(LibModule: PLibModule);
  1182. procedure UnregisterModule(LibModule: PLibModule);
  1183. function FindHInstance(Address: Pointer): LongWord;
  1184. function FindClassHInstance(ClassType: TClass): LongWord;
  1185. function FindResourceHInstance(Instance: LongWord): LongWord;
  1186. function LoadResourceModule(ModuleName: PChar; CheckOwner: Boolean = True): LongWord;
  1187. procedure EnumModules(Func: TEnumModuleFunc; Data: Pointer); overload;
  1188. procedure EnumResourceModules(Func: TEnumModuleFunc; Data: Pointer); overload;
  1189. procedure EnumModules(Func: TEnumModuleFuncLW; Data: Pointer); overload;
  1190. procedure EnumResourceModules(Func: TEnumModuleFuncLW; Data: Pointer); overload;
  1191. procedure AddModuleUnloadProc(Proc: TModuleUnloadProc); overload;
  1192. procedure RemoveModuleUnloadProc(Proc: TModuleUnloadProc); overload;
  1193. procedure AddModuleUnloadProc(Proc: TModuleUnloadProcLW); overload;
  1194. procedure RemoveModuleUnloadProc(Proc: TModuleUnloadProcLW); overload;
  1195. {$IFDEF LINUX}
  1196. { Given an HMODULE, this function will return its fully qualified name.  There is
  1197.   no direct equivalent in Linux so this function provides that capability. }
  1198. function GetModuleFileName(Module: HMODULE; Buffer: PChar; BufLen: Integer): Integer;
  1199. {$ENDIF}
  1200.  
  1201. { ResString support function/record }
  1202.  
  1203. type
  1204.   PResStringRec = ^TResStringRec;
  1205.   TResStringRec = packed record
  1206.     Module: ^Cardinal;
  1207.     Identifier: Integer;
  1208.   end;
  1209.  
  1210. function LoadResString(ResStringRec: PResStringRec): string;
  1211.  
  1212. { Procedures and functions that need compiler magic }
  1213.  
  1214. procedure _COS;
  1215. procedure _EXP;
  1216. procedure _INT;
  1217. procedure _SIN;
  1218. procedure _FRAC;
  1219. procedure _ROUND;
  1220. procedure _TRUNC;
  1221.  
  1222. procedure _AbstractError;
  1223. procedure _Assert(const Message, Filename: AnsiString; LineNumber: Integer);
  1224. function _Append(var t: TTextRec): Integer;
  1225. function _Assign(var t: TTextRec; const S: String): Integer;
  1226. function _BlockRead(var f: TFileRec; buffer: Pointer; recCnt: Longint; var recsRead: Longint): Longint;
  1227. function  _BlockWrite(var f: TFileRec; buffer: Pointer; recCnt: Longint; var recsWritten: Longint): Longint;
  1228. function _Close(var t: TTextRec): Integer;
  1229. procedure _PStrCat;
  1230. procedure _PStrNCat;
  1231. procedure _PStrCpy(Dest: PShortString; Source: PShortString);
  1232. procedure _PStrNCpy(Dest: PShortString; Source: PShortString; MaxLen: Byte);
  1233. function _EofFile(var f: TFileRec): Boolean;
  1234. function _EofText(var t: TTextRec): Boolean;
  1235. function _Eoln(var t: TTextRec): Boolean;
  1236. procedure _Erase(var f: TFileRec);
  1237. function _FilePos(var f: TFileRec): Longint;
  1238. function _FileSize(var f: TFileRec): Longint;
  1239. procedure _FillChar(var Dest; count: Integer; Value: Char);
  1240. function _FreeMem(P: Pointer): Integer;
  1241. function _GetMem(Size: Integer): Pointer;
  1242. function _ReallocMem(var P: Pointer; NewSize: Integer): Pointer;
  1243. procedure _Halt(Code: Integer);
  1244. procedure _Halt0;
  1245. procedure Mark; deprecated;
  1246. procedure _PStrCmp;
  1247. procedure _AStrCmp;
  1248. procedure _RandInt;
  1249. procedure _RandExt;
  1250. function _ReadRec(var f: TFileRec; Buffer: Pointer): Integer;
  1251. function _ReadChar(var t: TTextRec): Char;
  1252. function _ReadLong(var t: TTextRec): Longint;
  1253. procedure _ReadString(var t: TTextRec; s: PShortString; maxLen: Longint);
  1254. procedure _ReadCString(var t: TTextRec; s: PChar; maxLen: Longint);
  1255. procedure _ReadLString(var t: TTextRec; var s: AnsiString);
  1256. procedure _ReadWString(var t: TTextRec; var s: WideString);
  1257. procedure _ReadWCString(var t: TTextRec; s: PWideChar; maxBytes: Longint);
  1258. function _ReadWChar(var t: TTextRec): WideChar;
  1259. function _ReadExt(var t: TTextRec): Extended;
  1260. procedure _ReadLn(var t: TTextRec);
  1261. procedure _Rename(var f: TFileRec; newName: PChar);
  1262. procedure Release; deprecated;
  1263. function _ResetText(var t: TTextRec): Integer;
  1264. function _ResetFile(var f: TFileRec; recSize: Longint): Integer;
  1265. function _RewritText(var t: TTextRec): Integer;
  1266. function _RewritFile(var f: TFileRec; recSize: Longint): Integer;
  1267. procedure _RunError(errorCode: Byte);
  1268. procedure _Run0Error;
  1269. procedure _Seek(var f: TFileRec; recNum: Cardinal);
  1270. function _SeekEof(var t: TTextRec): Boolean;
  1271. function _SeekEoln(var t: TTextRec): Boolean;
  1272. procedure _SetTextBuf(var t: TTextRec; p: Pointer; size: Longint);
  1273. procedure _StrLong(val, width: Longint; s: PShortString);
  1274. procedure _Str0Long(val: Longint; s: PShortString);
  1275. procedure _Truncate(var f: TFileRec);
  1276. function _ValLong(const s: String; var code: Integer): Longint;
  1277. {$IFDEF LINUX}
  1278. procedure _UnhandledException;
  1279. {$ENDIF}
  1280. function _WriteRec(var f: TFileRec; buffer: Pointer): Pointer;
  1281. function _WriteChar(var t: TTextRec; c: Char; width: Integer): Pointer;
  1282. function _Write0Char(var t: TTextRec; c: Char): Pointer;
  1283. function _WriteBool(var t: TTextRec; val: Boolean; width: Longint): Pointer;
  1284. function _Write0Bool(var t: TTextRec; val: Boolean): Pointer;
  1285. function _WriteLong(var t: TTextRec; val, width: Longint): Pointer;
  1286. function _Write0Long(var t: TTextRec; val: Longint): Pointer;
  1287. function _WriteString(var t: TTextRec; const s: ShortString; width: Longint): Pointer;
  1288. function _Write0String(var t: TTextRec; const s: ShortString): Pointer;
  1289. function _WriteCString(var t: TTextRec; s: PChar; width: Longint): Pointer;
  1290. function _Write0CString(var t: TTextRec; s: PChar): Pointer;
  1291. function _Write0LString(var t: TTextRec; const s: AnsiString): Pointer;
  1292. function _WriteLString(var t: TTextRec; const s: AnsiString; width: Longint): Pointer;
  1293. function _Write0WString(var t: TTextRec; const s: WideString): Pointer;
  1294. function _WriteWString(var t: TTextRec; const s: WideString; width: Longint): Pointer;
  1295. function _WriteWCString(var t: TTextRec; s: PWideChar; width: Longint): Pointer;
  1296. function _Write0WCString(var t: TTextRec; s: PWideChar): Pointer;
  1297. function _WriteWChar(var t: TTextRec; c: WideChar; width: Integer): Pointer;
  1298. function _Write0WChar(var t: TTextRec; c: WideChar): Pointer;
  1299. procedure _Write2Ext;
  1300. procedure _Write1Ext;
  1301. procedure _Write0Ext;
  1302. function _WriteLn(var t: TTextRec): Pointer;
  1303.  
  1304. procedure __CToPasStr(Dest: PShortString; const Source: PChar);
  1305. procedure __CLenToPasStr(Dest: PShortString; const Source: PChar; MaxLen: Integer);
  1306. procedure __ArrayToPasStr(Dest: PShortString; const Source: PChar; Len: Integer);
  1307. procedure __PasToCStr(const Source: PShortString; const Dest: PChar);
  1308.  
  1309. procedure __IOTest;
  1310. function _Flush(var t: TTextRec): Integer;
  1311.  
  1312. procedure _SetElem;
  1313. procedure _SetRange;
  1314. procedure _SetEq;
  1315. procedure _SetLe;
  1316. procedure _SetIntersect;
  1317. procedure _SetIntersect3; { BEG only }
  1318. procedure _SetUnion;
  1319. procedure _SetUnion3; { BEG only }
  1320. procedure _SetSub;
  1321. procedure _SetSub3; { BEG only }
  1322. procedure _SetExpand;
  1323.  
  1324. procedure _Str2Ext;
  1325. procedure _Str0Ext;
  1326. procedure _Str1Ext;
  1327. procedure _ValExt;
  1328. procedure _Pow10;
  1329. procedure _Real2Ext;
  1330. procedure _Ext2Real;
  1331.  
  1332. procedure _ObjSetup;
  1333. procedure _ObjCopy;
  1334. procedure _Fail;
  1335. procedure _BoundErr;
  1336. procedure _IntOver;
  1337.  
  1338. { Module initialization context.  For internal use only. }
  1339.  
  1340. type
  1341.   PInitContext = ^TInitContext;
  1342.   TInitContext = record
  1343.     OuterContext:   PInitContext;     { saved InitContext   }
  1344. {$IFNDEF PC_MAPPED_EXCEPTIONS}
  1345.     ExcFrame:       Pointer;          { bottom exc handler  }
  1346. {$ENDIF}
  1347.     InitTable:      PackageInfo;      { unit init info      }
  1348.     InitCount:      Integer;          { how far we got      }
  1349.     Module:         PLibModule;       { ptr to module desc  }
  1350.     DLLSaveEBP:     Pointer;          { saved regs for DLLs }
  1351.     DLLSaveEBX:     Pointer;          { saved regs for DLLs }
  1352.     DLLSaveESI:     Pointer;          { saved regs for DLLs }
  1353.     DLLSaveEDI:     Pointer;          { saved regs for DLLs }
  1354. {$IFDEF MSWINDOWS}
  1355.     ExitProcessTLS: procedure;        { Shutdown for TLS    }
  1356. {$ENDIF}
  1357.     DLLInitState:   Byte;             { 0 = package, 1 = DLL shutdown, 2 = DLL startup }
  1358.   end platform;
  1359.  
  1360. type
  1361.   TDLLProc = procedure (Reason: Integer);
  1362.   // TDLLProcEx provides the reserved param returned by WinNT
  1363.   TDLLProcEx = procedure (Reason: Integer; Reserved: Integer);
  1364.  
  1365. {$IFDEF LINUX}
  1366. procedure _StartExe(InitTable: PackageInfo; Module: PLibModule; Argc: Integer; Argv: Pointer);
  1367. procedure _StartLib(Context: PInitContext; Module: PLibModule; DLLProc: TDLLProcEx);
  1368. {$ENDIF}
  1369. {$IFDEF MSWINDOWS}
  1370. procedure _StartExe(InitTable: PackageInfo; Module: PLibModule);
  1371. procedure _StartLib;
  1372. {$ENDIF}
  1373. procedure _PackageLoad(const Table : PackageInfo; Module: PLibModule);
  1374. procedure _PackageUnload(const Table : PackageInfo; Module: PLibModule);
  1375. procedure _InitResStrings;
  1376. procedure _InitResStringImports;
  1377. procedure _InitImports;
  1378. {$IFDEF MSWINDOWS}
  1379. procedure _InitWideStrings;
  1380. {$ENDIF}
  1381.  
  1382. function _ClassCreate(AClass: TClass; Alloc: Boolean): TObject;
  1383. procedure _ClassDestroy(Instance: TObject);
  1384. function _AfterConstruction(Instance: TObject): TObject;
  1385. function _BeforeDestruction(Instance: TObject; OuterMost: ShortInt): TObject;
  1386. function _IsClass(Child: TObject; Parent: TClass): Boolean;
  1387. function _AsClass(Child: TObject; Parent: TClass): TObject;
  1388.  
  1389. {$IFDEF PC_MAPPED_EXCEPTIONS}
  1390. procedure _RaiseAtExcept;
  1391. //procedure _DestroyException(Exc: PRaisedException);
  1392. procedure _DestroyException;
  1393. {$ENDIF}
  1394. procedure _RaiseExcept;
  1395. procedure _RaiseAgain;
  1396. procedure _DoneExcept;
  1397. {$IFNDEF PC_MAPPED_EXCEPTIONS}
  1398. procedure _TryFinallyExit;
  1399. {$ENDIF}
  1400. procedure _HandleAnyException;
  1401. procedure _HandleFinally;
  1402. procedure _HandleOnException;
  1403. {$IFDEF PC_MAPPED_EXCEPTIONS}
  1404. procedure _HandleOnExceptionPIC;
  1405. {$ENDIF}
  1406. procedure _HandleAutoException;
  1407. {$IFDEF PC_MAPPED_EXCEPTIONS}
  1408. procedure _ClassHandleException;
  1409. {$ENDIF}
  1410.  
  1411. procedure _CallDynaInst;
  1412. procedure _CallDynaClass;
  1413. procedure _FindDynaInst;
  1414. procedure _FindDynaClass;
  1415.  
  1416. procedure _LStrClr(var S);
  1417. procedure _LStrArrayClr(var StrArray; cnt: longint);
  1418. procedure _LStrAsg(var dest; const source);
  1419. procedure _LStrLAsg(var dest; const source);
  1420. procedure _LStrFromPCharLen(var Dest: AnsiString; Source: PAnsiChar; Length: Integer);
  1421. procedure _LStrFromPWCharLen(var Dest: AnsiString; Source: PWideChar; Length: Integer);
  1422. procedure _LStrFromChar(var Dest: AnsiString; Source: AnsiChar);
  1423. procedure _LStrFromWChar(var Dest: AnsiString; Source: WideChar);
  1424. procedure _LStrFromPChar(var Dest: AnsiString; Source: PAnsiChar);
  1425. procedure _LStrFromPWChar(var Dest: AnsiString; Source: PWideChar);
  1426. procedure _LStrFromString(var Dest: AnsiString; const Source: ShortString);
  1427. procedure _LStrFromArray(var Dest: AnsiString; Source: PAnsiChar; Length: Integer);
  1428. procedure _LStrFromWArray(var Dest: AnsiString; Source: PWideChar; Length: Integer);
  1429. procedure _LStrFromWStr(var Dest: AnsiString; const Source: WideString);
  1430. procedure _LStrToString{(var Dest: ShortString; const Source: AnsiString; MaxLen: Integer)};
  1431. function _LStrLen(const s: AnsiString): Longint;
  1432. procedure _LStrCat{var dest: AnsiString; source: AnsiString};
  1433. procedure _LStrCat3{var dest:AnsiString; source1: AnsiString; source2: AnsiString};
  1434. procedure _LStrCatN{var dest:AnsiString; argCnt: Integer; ...};
  1435. procedure _LStrCmp{left: AnsiString; right: AnsiString};
  1436. function _LStrAddRef(var str): Pointer;
  1437. function _LStrToPChar(const s: AnsiString): PChar;
  1438. procedure _Copy{ s : ShortString; index, count : Integer ) : ShortString};
  1439. procedure _Delete{ var s : openstring; index, count : Integer };
  1440. procedure _Insert{ source : ShortString; var s : openstring; index : Integer };
  1441. procedure _Pos{ substr : ShortString; s : ShortString ) : Integer};
  1442. procedure _SetLength(s: PShortString; newLength: Byte);
  1443. procedure _SetString(s: PShortString; buffer: PChar; len: Byte);
  1444.  
  1445. procedure UniqueString(var str: AnsiString); overload;
  1446. procedure UniqueString(var str: WideString); overload;
  1447. procedure _UniqueStringA(var str: AnsiString);
  1448. procedure _UniqueStringW(var str: WideString);
  1449.  
  1450.  
  1451. procedure _LStrCopy  { const s : AnsiString; index, count : Integer) : AnsiString};
  1452. procedure _LStrDelete{ var s : AnsiString; index, count : Integer };
  1453. procedure _LStrInsert{ const source : AnsiString; var s : AnsiString; index : Integer };
  1454. procedure _LStrPos{ const substr : AnsiString; const s : AnsiString ) : Integer};
  1455. procedure _LStrSetLength{ var str: AnsiString; newLength: Integer};
  1456. procedure _LStrOfChar{ c: Char; count: Integer): AnsiString };
  1457. function _NewAnsiString(length: Longint): Pointer;      { for debugger purposes only }
  1458. function _NewWideString(CharLength: Longint): Pointer;
  1459.  
  1460. procedure _WStrClr(var S);
  1461. procedure _WStrArrayClr(var StrArray; Count: Integer);
  1462. procedure _WStrAsg(var Dest: WideString; const Source: WideString);
  1463. procedure _WStrLAsg(var Dest: WideString; const Source: WideString);
  1464. function _WStrToPWChar(const S: WideString): PWideChar;
  1465. function _WStrLen(const S: WideString): Integer;
  1466. procedure _WStrFromPCharLen(var Dest: WideString; Source: PAnsiChar; Length: Integer);
  1467. procedure _WStrFromPWCharLen(var Dest: WideString; Source: PWideChar; CharLength: Integer);
  1468. procedure _WStrFromChar(var Dest: WideString; Source: AnsiChar);
  1469. procedure _WStrFromWChar(var Dest: WideString; Source: WideChar);
  1470. procedure _WStrFromPChar(var Dest: WideString; Source: PAnsiChar);
  1471. procedure _WStrFromPWChar(var Dest: WideString; Source: PWideChar);
  1472. procedure _WStrFromString(var Dest: WideString; const Source: ShortString);
  1473. procedure _WStrFromArray(var Dest: WideString; Source: PAnsiChar; Length: Integer);
  1474. procedure _WStrFromWArray(var Dest: WideString; Source: PWideChar; Length: Integer);
  1475. procedure _WStrFromLStr(var Dest: WideString; const Source: AnsiString);
  1476. procedure _WStrToString(Dest: PShortString; const Source: WideString; MaxLen: Integer);
  1477. procedure _WStrCat(var Dest: WideString; const Source: WideString);
  1478. procedure _WStrCat3(var Dest: WideString; const Source1, Source2: WideString);
  1479. procedure _WStrCatN{var dest:WideString; argCnt: Integer; ...};
  1480. procedure _WStrCmp{left: WideString; right: WideString};
  1481. function _WStrCopy(const S: WideString; Index, Count: Integer): WideString;
  1482. procedure _WStrDelete(var S: WideString; Index, Count: Integer);
  1483. procedure _WStrInsert(const Source: WideString; var Dest: WideString; Index: Integer);
  1484. procedure _WStrPos{ const substr : WideString; const s : WideString ) : Integer};
  1485. procedure _WStrSetLength(var S: WideString; NewLength: Integer);
  1486. function _WStrOfWChar(Ch: WideChar; Count: Integer): WideString;
  1487. function _WStrAddRef(var str: WideString): Pointer;
  1488.  
  1489. procedure _Initialize(p: Pointer; typeInfo: Pointer);
  1490. procedure _InitializeArray(p: Pointer; typeInfo: Pointer; elemCount: Cardinal);
  1491. procedure _InitializeRecord(p: Pointer; typeInfo: Pointer);
  1492. procedure _Finalize(p: Pointer; typeInfo: Pointer);
  1493. procedure _FinalizeArray(p: Pointer; typeInfo: Pointer; elemCount: Cardinal);
  1494. procedure _FinalizeRecord(P: Pointer; typeInfo: Pointer);
  1495. procedure _AddRef;
  1496. procedure _AddRefArray;
  1497. procedure _AddRefRecord;
  1498. procedure _CopyArray;
  1499. procedure _CopyRecord;
  1500. procedure _CopyObject;
  1501.  
  1502. function _New(size: Longint; typeInfo: Pointer): Pointer;
  1503. procedure _Dispose(p: Pointer; typeInfo: Pointer);
  1504.  
  1505. { 64-bit Integer helper routines }
  1506. procedure __llmul;
  1507. procedure __lldiv;
  1508. procedure __lludiv;
  1509. procedure __llmod;
  1510. procedure __llmulo;
  1511. procedure __lldivo;
  1512. procedure __llmodo;
  1513. procedure __llumod;
  1514. procedure __llshl;
  1515. procedure __llushr;
  1516. procedure _WriteInt64;
  1517. procedure _Write0Int64;
  1518. procedure _ReadInt64;
  1519. function _StrInt64(val: Int64; width: Integer): ShortString;
  1520. function _Str0Int64(val: Int64): ShortString;
  1521. function _ValInt64(const s: AnsiString; var code: Integer): Int64;
  1522.  
  1523. { Dynamic array helper functions }
  1524.  
  1525. procedure _DynArrayHigh;
  1526. procedure _DynArrayClear(var a: Pointer; typeInfo: Pointer);
  1527. procedure _DynArrayLength;
  1528. procedure _DynArraySetLength;
  1529. procedure _DynArrayCopy(a: Pointer; typeInfo: Pointer; var Result: Pointer);
  1530. procedure _DynArrayCopyRange(a: Pointer; typeInfo: Pointer; index, count : Integer; var Result: Pointer);
  1531. procedure _DynArrayAsg;
  1532. procedure _DynArrayAddRef;
  1533.  
  1534. procedure DynArrayClear(var a: Pointer; typeInfo: Pointer);
  1535. procedure DynArraySetLength(var a: Pointer; typeInfo: Pointer; dimCnt: Longint; lengthVec: PLongint);
  1536. function DynArrayDim(typeInfo: PDynArrayTypeInfo): Integer;
  1537. {$NODEFINE DynArrayDim}
  1538.  
  1539. function _IntfClear(var Dest: IInterface): Pointer;
  1540. procedure _IntfCopy(var Dest: IInterface; const Source: IInterface);
  1541. procedure _IntfCast(var Dest: IInterface; const Source: IInterface; const IID: TGUID);
  1542. procedure _IntfAddRef(const Dest: IInterface);
  1543.  
  1544. {$IFDEF MSWINDOWS}
  1545. procedure _FSafeDivide;
  1546. procedure _FSafeDivideR;
  1547. {$ENDIF}
  1548.  
  1549. function _CheckAutoResult(ResultCode: HResult): HResult;
  1550.  
  1551. procedure FPower10;
  1552.  
  1553. procedure TextStart; deprecated;
  1554.  
  1555. // Conversion utility routines for C++ convenience.  Not for Delphi code.
  1556. function  CompToDouble(Value: Comp): Double; cdecl;
  1557. procedure DoubleToComp(Value: Double; var Result: Comp); cdecl;
  1558. function  CompToCurrency(Value: Comp): Currency; cdecl;
  1559. procedure CurrencyToComp(Value: Currency; var Result: Comp); cdecl;
  1560.  
  1561. function GetMemory(Size: Integer): Pointer; cdecl;
  1562. function FreeMemory(P: Pointer): Integer; cdecl;
  1563. function ReallocMemory(P: Pointer; Size: Integer): Pointer; cdecl;
  1564.  
  1565. { Internal runtime error codes }
  1566.  
  1567. type
  1568.   TRuntimeError = (reNone, reOutOfMemory, reInvalidPtr, reDivByZero,
  1569.   reRangeError, reIntOverflow, reInvalidOp, reZeroDivide, reOverflow,
  1570.   reUnderflow, reInvalidCast, reAccessViolation, rePrivInstruction,
  1571.   reControlBreak, reStackOverflow,
  1572.   { reVar* used in Variants.pas }
  1573.   reVarTypeCast, reVarInvalidOp,
  1574.   reVarDispatch, reVarArrayCreate, reVarNotArray, reVarArrayBounds,
  1575.   reAssertionFailed,
  1576.   reExternalException, { not used here; in SysUtils }
  1577.   reIntfCastError, reSafeCallError);
  1578. {$NODEFINE TRuntimeError}
  1579.  
  1580. procedure Error(errorCode: TRuntimeError);
  1581. {$NODEFINE Error}
  1582.  
  1583. { GetLastError returns the last error reported by an OS API call.  Calling
  1584.   this function usually resets the OS error state.
  1585. }
  1586.  
  1587. function GetLastError: Integer; {$IFDEF MSWINDOWS} stdcall; {$ENDIF}
  1588. {$EXTERNALSYM GetLastError}
  1589.  
  1590. { SetLastError writes to the thread local storage area read by GetLastError. }
  1591.  
  1592. procedure SetLastError(ErrorCode: Integer); {$IFDEF MSWINDOWS} stdcall; {$ENDIF}
  1593.  
  1594. {$IFDEF LINUX}
  1595. {  To improve performance, some RTL routines cache module handles and data
  1596.    derived from modules.  If an application dynamically loads and unloads
  1597.    shared object libraries, packages, or resource packages, it is possible for
  1598.    the handle of the newly loaded module to match the handle of a recently
  1599.    unloaded module.  The resource caches have no way to detect when this happens.
  1600.  
  1601.    To address this issue, the RTL maintains an internal counter that is
  1602.    incremented every time a module is loaded or unloaded using RTL functions
  1603.    (like LoadPackage).  This provides a cache version level signature that
  1604.    can detect when modules have been cycled but have the same handle.
  1605.  
  1606.    If you load or unload modules "by hand" using dlopen or dlclose, you must call
  1607.    InvalidateModuleCache after each load or unload so that the RTL module handle
  1608.    caches will refresh themselves properly the next time they are used.  This is
  1609.    especially important if you manually tinker with the LibModuleList list of
  1610.    loaded modules, or manually add or remove resource modules in the nodes
  1611.    of that list.
  1612.  
  1613.    ModuleCacheID returns the "current generation" or version number kept by
  1614.    the RTL.  You can use this to implement your own refresh-on-next-use
  1615.    (passive) module handle caches as the RTL does.  The value changes each
  1616.    time InvalidateModuleCache is called.
  1617. }
  1618.  
  1619. function ModuleCacheID: Cardinal;
  1620. procedure InvalidateModuleCache;
  1621. {$ENDIF}
  1622.  
  1623. {$IFDEF LINUX}
  1624. {  When a process that is being debugged is stopped while it has the mouse
  1625.    pointer grabbed, there is no way for the debugger to release the grab on
  1626.    behalf of the process. The process needs to do it itself. To accomplish this,
  1627.    the debugger causes DbgUnlockX to execute whenever it detects the process
  1628.    might have the mouse grabbed. This method will call through DbgUnlockXProc
  1629.    which should be assigned by any library using X and locks the X pointer. This
  1630.    method should be chained, by storing of the previous instance and calling it
  1631.    when you are called, since there might be more than one display that needs
  1632.    to be unlocked. This method should call XUngrabPointer on the display that
  1633.    has the pointer grabbed.
  1634. }
  1635. var
  1636.   DbgUnlockXProc: procedure;
  1637.  
  1638. procedure DbgUnlockX;
  1639. {$ENDIF}
  1640.  
  1641. (* =================================================================== *)
  1642.  
  1643. implementation
  1644.